home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 10 / AACD 10.iso / AACD / Online / SpeakFreely / src / libdes / shifts.pl < prev    next >
Text File  |  2000-05-18  |  2KB  |  161 lines
  1. sub lab_shift
  2.     {
  3.     local(*a,$n)=@_;
  4.     local(@r,$i,$j,$k,$d,@z);
  5.  
  6.     @r=&shift(*a,$n);
  7.     foreach $i (0 .. 31)
  8.         {
  9.         @z=split(/\^/,$r[$i]);
  10.         for ($j=0; $j <= $#z; $j++)
  11.             {
  12.             ($d)=($z[$j] =~ /^(..)/);
  13.             ($k)=($z[$j] =~ /\[(.*)\]$/);
  14.             $k.=",$n" if ($k ne "");
  15.             $k="$n"      if ($k eq "");
  16.             $d="$d[$k]";
  17.             $z[$j]=$d;
  18.             }
  19.         $r[$i]=join('^',@z);
  20.         }
  21.     return(@r);
  22.     }
  23.  
  24. sub shift
  25.     {
  26.     local(*a,$n)=@_;
  27.     local(@f);
  28.  
  29.     if ($n > 0)
  30.         {
  31.         @f=&shiftl(*a,$n);
  32.         }
  33.     else
  34.         {
  35.         @f=&shiftr(*a,-$n);
  36.         }
  37.     return(@f);
  38.     }
  39.  
  40. sub shiftr
  41.     {
  42.     local(*a,$n)=@_;
  43.     local(@r,$i);
  44.  
  45.     $#r=31;
  46.     foreach $i (0 .. 31)
  47.         {
  48.         if (($i+$n) > 31)
  49.             {
  50.             $r[$i]="--";
  51.             }
  52.         else
  53.             {
  54.             $r[$i]=$a[$i+$n];
  55.             }
  56.         }
  57.     return(@r);
  58.     }
  59.  
  60. sub shiftl
  61.     {
  62.     local(*a,$n)=@_;
  63.     local(@r,$i);
  64.  
  65.     $#r=31;
  66.     foreach $i (0 .. 31)
  67.         {
  68.         if ($i < $n)
  69.             {
  70.             $r[$i]="--";
  71.             }
  72.         else
  73.             {
  74.             $r[$i]=$a[$i-$n];
  75.             }
  76.         }
  77.     return(@r);
  78.     }
  79.  
  80. sub printit
  81.     {
  82.     local(@a)=@_;
  83.     local($i);
  84.  
  85.     foreach $i (0 .. 31)
  86.         {
  87.         printf "%2s  ",$a[$i];
  88.         print "\n" if (($i%8) == 7);
  89.         }
  90.     print "\n";
  91.     }
  92.  
  93. sub xor
  94.     {
  95.     local(*a,*b)=@_;
  96.     local(@r,$i);
  97.  
  98.     $#r=31;
  99.     foreach $i (0 .. 31)
  100.         {
  101.         $r[$i]=&compress($a[$i].'^'.$b[$i]);
  102. #        $r[$i]=$a[$i]."^".$b[$i];
  103.         }
  104.     return(@r);
  105.     }
  106.  
  107. sub and
  108.     {
  109.     local(*a,$m)=@_;
  110.     local(@r,$i);
  111.  
  112.     $#r=31;
  113.     foreach $i (0 .. 31)
  114.         {
  115.         $r[$i]=(($m & (1<<$i))?($a[$i]):('--'));
  116.         }
  117.     return(@r);
  118.     }
  119.  
  120. sub or
  121.     {
  122.     local(*a,*b)=@_;
  123.     local(@r,$i);
  124.  
  125.     $#r=31;
  126.     foreach $i (0 .. 31)
  127.         {
  128.         $r[$i]='--'   if (($a[$i] eq '--') && ($b[$i] eq '--'));
  129.         $r[$i]=$a[$i] if (($a[$i] ne '--') && ($b[$i] eq '--'));
  130.         $r[$i]=$b[$i] if (($a[$i] eq '--') && ($b[$i] ne '--'));
  131.         $r[$i]='++'   if (($a[$i] ne '--') && ($b[$i] ne '--'));
  132.         }
  133.     return(@r);
  134.     }
  135.  
  136. sub compress
  137.     {
  138.     local($s)=@_;
  139.     local($_,$i,@a,%a,$r);
  140.  
  141.     $s =~ s/\^\^/\^/g;
  142.     $s =~ s/^\^//;
  143.     $s =~ s/\^$//;
  144.     @a=split(/\^/,$s);
  145.  
  146.     while ($#a >= 0)
  147.         {
  148.         $_=shift(@a);
  149.         next unless /\d/;
  150.         $a{$_}++;
  151.         }
  152.     foreach $i (sort keys %a)
  153.         {
  154.         next if ($a{$i}%2 == 0);
  155.         $r.="$i^";
  156.         }
  157.     chop($r);
  158.     return($r);
  159.     }
  160. 1;
  161.